'For Grape
Sub ShowFilterCriteria()
    Dim WholeTable As Range

    Set WholeTable = Range("A1:A1")
    On Error Resume Next

    If WholeTable.Parent.AutoFilter Is Nothing Then                     ' if no filter is applied
        MsgBox "No Filter"
        Exit Sub
    End If

    Dim LongStr As String, FirstOne As Boolean
    Dim RowCount As Integer

    LongStr = ""
    FirstOne = False
    RowCount = ActiveSheet.UsedRange.Find("*", LookIn:=xlValues, searchorder:=xlByRows, searchdirection:=xlPrevious).row
    Dim iFilt As Integer
    For iFilt = 1 To WholeTable.Parent.AutoFilter.Filters.Count         ' loop through each column of the table
        Dim ThisFilt As Filter
        Set ThisFilt = WholeTable.Parent.AutoFilter.Filters(iFilt)      ' look at each filter
        On Error Resume Next
        With ThisFilt
            If .On Then
                If FirstOne Then LongStr = LongStr & "*"            ' Get column title
                'LongStr = LongStr & "[" & WholeTable.Parent.Cells(1, WholeTable.Column + iFilt - 1).Value & ":"
                On Error GoTo Handle
                If .Operator = xlFilterValues Then
                    values = .Criteria1
                    Dim valueStr() As String
                    ReDim Preserve valueStr(UBound(values) - LBound(values))
                    Count = 0
                    Dim tempString As String
                    For i = LBound(values) To UBound(values)
                        tempString = values(i)
                        valueStr(Count) = CreateExactString(Right(tempString, Len(tempString) - 1), iFilt, 2, iFilt, RowCount)
                        Count = Count + 1
                    Next i
                    LongStr = LongStr & "(" & Join(valueStr, "+") + ")"
                ElseIf .Operator = 0 Then
                    LongStr = LongStr & CreateExactString(Right(.Criteria1, Len(.Criteria1) - 1), iFilt, 2, iFilt, RowCount)
                ElseIf .Operator = xlAnd Then
                    LongStr = LongStr & CreateExactString(Right(.Criteria1, Len(.Criteria1) - 1), iFilt, 2, iFilt, RowCount) & "*" & CreateExactString(Right(.Criteria2, Len(.Criteria2) - 1), iFilt, 2, iFilt, RowCount)
                ElseIf .Operator = xlOr Then
                    LongStr = LongStr & "(" + CreateExactString(Right(.Criteria1, Len(.Criteria1) - 1), iFilt, 2, iFilt, RowCount) & "+" & CreateExactString(Right(.Criteria2, Len(.Criteria2) - 1), iFilt, 2, iFilt, RowCount) + ")"
                End If
                On Error GoTo 0
                FirstOne = True
            End If
        End With
    Next

On Error GoTo 0
Debug.Print LongStr
Exit Sub

Handle:
On Error GoTo 0

End Sub

Function CreateExactString(str As Variant, col0 As Integer, row0 As Integer, col1 As Integer, row1 As Integer)
    CreateExactString = "(""" + str + """=" + ActiveSheet.Name + "!" + CreateRangeString(col0, row0, col1, row1) + ")"
End Function

Function CreateRangeString(col0 As Integer, row0 As Integer, col1 As Integer, row1 As Integer)
    CreateRangeString = "$" & ConvertToLetter(col0) & "$" & row0 & ":" & "$" & ConvertToLetter(col1) & "$" & row1
End Function

'数字列号转换
Function ConvertToLetter(iCol As Integer) As String
    Dim iAlpha As Integer
    Dim iRemainder As Integer
    iAlpha = Int(iCol / 27)
    iRemainder = iCol - (iAlpha * 26)
    If iAlpha > 0 Then
       ConvertToLetter = Chr(iAlpha + 64)
    End If
    If iRemainder > 0 Then
       ConvertToLetter = ConvertToLetter & Chr(iRemainder + 64)
    End If
End Function
